home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / util.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-12-31  |  36.7 KB  |  1,884 lines  |  [TEXT/MPS ]
  1. /*    util.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "Very useful, no doubt, that was to Saruman; yet it seems that he was
  12.  * not content."  --Gandalf
  13.  */
  14.  
  15. #ifdef macintosh
  16. #include <Types.h>
  17. #define pooled_malloc 1
  18. #endif
  19. #include "EXTERN.h"
  20. #include "perl.h"
  21.  
  22. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  23. #include <signal.h>
  24. #endif
  25.  
  26. /* Omit this -- it causes too much grief on mixed systems.
  27. #ifdef I_UNISTD
  28. #  include <unistd.h>
  29. #endif
  30. */
  31.  
  32. #ifdef I_VFORK
  33. #  include <vfork.h>
  34. #endif
  35.  
  36. #ifdef I_LIMITS  /* Needed for cast_xxx() functions below. */
  37. #  include <limits.h>
  38. #endif
  39.  
  40. /* Put this after #includes because fork and vfork prototypes may
  41.    conflict.
  42. */
  43. #ifndef HAS_VFORK
  44. #   define vfork fork
  45. #endif
  46.  
  47. #ifdef I_FCNTL
  48. #  include <fcntl.h>
  49. #endif
  50. #ifdef I_SYS_FILE
  51. #  include <sys/file.h>
  52. #endif
  53.  
  54. #define FLUSH
  55.  
  56. #ifdef LEAKTEST
  57. static void xstat _((void));
  58. #endif
  59.  
  60. #ifndef safemalloc
  61.  
  62. /* paranoid version of malloc */
  63.  
  64. /* NOTE:  Do not call the next three routines directly.  Use the macros
  65.  * in handy.h, so that we can easily redefine everything to do tracking of
  66.  * allocated hunks back to the original New to track down any memory leaks.
  67.  */
  68.  
  69. #ifdef macintosh
  70. extern void * gSacrificialGoat;
  71. #endif
  72.  
  73. char *
  74. safemalloc(size)
  75. #ifdef MSDOS
  76. unsigned long size;
  77. #else
  78. MEM_SIZE size;
  79. #endif /* MSDOS */
  80. {
  81.     char  *ptr;
  82. #ifdef MSDOS
  83.     if (size > 0xffff) {
  84.         fprintf(stderr, "Allocation too large: %lx\n", size) FLUSH;
  85.         my_exit(1);
  86.     }
  87. #endif /* MSDOS */
  88. #ifdef DEBUGGING
  89.     if ((long)size < 0)
  90.     croak("panic: malloc");
  91. #endif
  92. #ifdef pooled_malloc
  93.     ptr = (char *) pool_malloc(gPerlPool, size?size:1);    /* malloc(0) is NASTY on our system */
  94. #else
  95.     ptr = malloc(size?size:1);    /* malloc(0) is NASTY on our system */
  96. #endif
  97. #if !(defined(I286) || defined(atarist))
  98.     DEBUG_m(fprintf(Perl_debug_log,"0x%x: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
  99. #else
  100.     DEBUG_m(fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
  101. #endif
  102. #ifdef macintosh
  103.     if (ptr != Nullch && gSacrificialGoat)
  104. #else
  105.     if (ptr != Nullch)
  106. #endif
  107.     return ptr;
  108.     else if (nomemok)
  109.     return Nullch;
  110.     else {
  111.     fputs(no_mem,stderr) FLUSH;
  112.     my_exit(1);
  113.     }
  114.     /*NOTREACHED*/
  115. }
  116.  
  117. /* paranoid version of realloc */
  118.  
  119. char *
  120. saferealloc(where,size)
  121. char *where;
  122. #ifndef MSDOS
  123. MEM_SIZE size;
  124. #else
  125. unsigned long size;
  126. #endif /* MSDOS */
  127. {
  128.     char *ptr;
  129. #if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
  130.     char *realloc();
  131. #endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */
  132.  
  133. #ifdef MSDOS
  134.     if (size > 0xffff) {
  135.         fprintf(stderr, "Reallocation too large: %lx\n", size) FLUSH;
  136.         my_exit(1);
  137.     }
  138. #endif /* MSDOS */
  139.     if (!where)
  140.     croak("Null realloc");
  141. #ifdef DEBUGGING
  142.     if ((long)size < 0)
  143.     croak("panic: realloc");
  144. #endif
  145. #ifdef pooled_malloc
  146.     ptr = (void *) pool_realloc(gPerlPool, where, size?size:1);    /* realloc(0) is NASTY on our system */
  147. #else
  148.     ptr = realloc(where,size?size:1);    /* realloc(0) is NASTY on our system */
  149. #endif
  150.  
  151. #if !(defined(I286) || defined(atarist))
  152.     DEBUG_m( {
  153.     fprintf(Perl_debug_log,"0x%x: (%05d) rfree\n",where,an++);
  154.     fprintf(Perl_debug_log,"0x%x: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
  155.     } )
  156. #else
  157.     DEBUG_m( {
  158.     fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
  159.     fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
  160.     } )
  161. #endif
  162.  
  163. #ifdef macintosh
  164.     if (ptr != Nullch && gSacrificialGoat)
  165. #else
  166.     if (ptr != Nullch)
  167. #endif
  168.     return ptr;
  169.     else if (nomemok)
  170.     return Nullch;
  171.     else {
  172.     fputs(no_mem,stderr) FLUSH;
  173.     my_exit(1);
  174.     }
  175.     /*NOTREACHED*/
  176. }
  177.  
  178. /* safe version of free */
  179.  
  180. void
  181. safefree(where)
  182. char *where;
  183. {
  184. #if !(defined(I286) || defined(atarist))
  185.     DEBUG_m( fprintf(Perl_debug_log,"0x%x: (%05d) free\n",where,an++));
  186. #else
  187.     DEBUG_m( fprintf(stderr,"0x%lx: (%05d) free\n",where,an++));
  188. #endif
  189.     if (where) {
  190.     /*SUPPRESS 701*/
  191. #ifdef pooled_malloc
  192.     pool_free(where);
  193. #else
  194.     free(where);
  195. #endif
  196.     }
  197. }
  198.  
  199. #endif /* !safemalloc */
  200.  
  201. #ifdef LEAKTEST
  202.  
  203. #define ALIGN sizeof(long)
  204.  
  205. char *
  206. safexmalloc(x,size)
  207. I32 x;
  208. MEM_SIZE size;
  209. {
  210.     register char *where;
  211.  
  212.     where = safemalloc(size + ALIGN);
  213.     xcount[x]++;
  214.     where[0] = x % 100;
  215.     where[1] = x / 100;
  216.     return where + ALIGN;
  217. }
  218.  
  219. char *
  220. safexrealloc(where,size)
  221. char *where;
  222. MEM_SIZE size;
  223. {
  224.     register char *new = saferealloc(where - ALIGN, size + ALIGN);
  225.     return new + ALIGN;
  226. }
  227.  
  228. void
  229. safexfree(where)
  230. char *where;
  231. {
  232.     I32 x;
  233.  
  234.     if (!where)
  235.     return;
  236.     where -= ALIGN;
  237.     x = where[0] + 100 * where[1];
  238.     xcount[x]--;
  239.     safefree(where);
  240. }
  241.  
  242. static void
  243. xstat()
  244. {
  245.     register I32 i;
  246.  
  247.     for (i = 0; i < MAXXCOUNT; i++) {
  248.     if (xcount[i] > lastxcount[i]) {
  249.         fprintf(stderr,"%2d %2d\t%ld\n", i / 100, i % 100, xcount[i]);
  250.         lastxcount[i] = xcount[i];
  251.     }
  252.     }
  253. }
  254.  
  255. #endif /* LEAKTEST */
  256.  
  257. /* copy a string up to some (non-backslashed) delimiter, if any */
  258.  
  259. char *
  260. cpytill(to,from,fromend,delim,retlen)
  261. register char *to;
  262. register char *from;
  263. register char *fromend;
  264. register int delim;
  265. I32 *retlen;
  266. {
  267.     char *origto = to;
  268.  
  269.     for (; from < fromend; from++,to++) {
  270.     if (*from == '\\') {
  271.         if (from[1] == delim)
  272.         from++;
  273.         else if (from[1] == '\\')
  274.         *to++ = *from++;
  275.     }
  276.     else if (*from == delim)
  277.         break;
  278.     *to = *from;
  279.     }
  280.     *to = '\0';
  281.     *retlen = to - origto;
  282.     return from;
  283. }
  284.  
  285. /* return ptr to little string in big string, NULL if not found */
  286. /* This routine was donated by Corey Satten. */
  287.  
  288. char *
  289. instr(big, little)
  290. register char *big;
  291. register char *little;
  292. {
  293.     register char *s, *x;
  294.     register I32 first;
  295.  
  296.     if (!little)
  297.     return big;
  298.     first = *little++;
  299.     if (!first)
  300.     return big;
  301.     while (*big) {
  302.     if (*big++ != first)
  303.         continue;
  304.     for (x=big,s=little; *s; /**/ ) {
  305.         if (!*x)
  306.         return Nullch;
  307.         if (*s++ != *x++) {
  308.         s--;
  309.         break;
  310.         }
  311.     }
  312.     if (!*s)
  313.         return big-1;
  314.     }
  315.     return Nullch;
  316. }
  317.  
  318. /* same as instr but allow embedded nulls */
  319.  
  320. char *
  321. ninstr(big, bigend, little, lend)
  322. register char *big;
  323. register char *bigend;
  324. char *little;
  325. char *lend;
  326. {
  327.     register char *s, *x;
  328.     register I32 first = *little;
  329.     register char *littleend = lend;
  330.  
  331.     if (!first && little >= littleend)
  332.     return big;
  333.     if (bigend - big < littleend - little)
  334.     return Nullch;
  335.     bigend -= littleend - little++;
  336.     while (big <= bigend) {
  337.     if (*big++ != first)
  338.         continue;
  339.     for (x=big,s=little; s < littleend; /**/ ) {
  340.         if (*s++ != *x++) {
  341.         s--;
  342.         break;
  343.         }
  344.     }
  345.     if (s >= littleend)
  346.         return big-1;
  347.     }
  348.     return Nullch;
  349. }
  350.  
  351. /* reverse of the above--find last substring */
  352.  
  353. char *
  354. rninstr(big, bigend, little, lend)
  355. register char *big;
  356. char *bigend;
  357. char *little;
  358. char *lend;
  359. {
  360.     register char *bigbeg;
  361.     register char *s, *x;
  362.     register I32 first = *little;
  363.     register char *littleend = lend;
  364.  
  365.     if (!first && little >= littleend)
  366.     return bigend;
  367.     bigbeg = big;
  368.     big = bigend - (littleend - little++);
  369.     while (big >= bigbeg) {
  370.     if (*big-- != first)
  371.         continue;
  372.     for (x=big+2,s=little; s < littleend; /**/ ) {
  373.         if (*s++ != *x++) {
  374.         s--;
  375.         break;
  376.         }
  377.     }
  378.     if (s >= littleend)
  379.         return big+1;
  380.     }
  381.     return Nullch;
  382. }
  383.  
  384. /* Initialize locale (and the fold[] array).*/
  385. int
  386. perl_init_i18nl14n(printwarn)    
  387.     int printwarn;
  388. {
  389.     int ok = 1;
  390.     /* returns
  391.      *    1 = set ok or not applicable,
  392.      *    0 = fallback to C locale,
  393.      *   -1 = fallback to C locale failed
  394.      */
  395. #if defined(HAS_SETLOCALE) && defined(LC_CTYPE)
  396.     char * lang     = getenv("LANG");
  397.     char * lc_all   = getenv("LC_ALL");
  398.     char * lc_ctype = getenv("LC_CTYPE");
  399.     int i;
  400.  
  401.     if (setlocale(LC_CTYPE, "") == NULL && (lc_all || lc_ctype || lang)) {
  402.     if (printwarn) {
  403.         fprintf(stderr, "warning: setlocale(LC_CTYPE, \"\") failed.\n");
  404.         fprintf(stderr,
  405.           "warning: LC_ALL = \"%s\", LC_CTYPE = \"%s\", LANG = \"%s\",\n",
  406.           lc_all   ? lc_all   : "(null)",
  407.           lc_ctype ? lc_ctype : "(null)",
  408.           lang     ? lang     : "(null)"
  409.           );
  410.         fprintf(stderr, "warning: falling back to the \"C\" locale.\n");
  411.     }
  412.     ok = 0;
  413.     if (setlocale(LC_CTYPE, "C") == NULL)
  414.         ok = -1;
  415.     }
  416.  
  417.     for (i = 0; i < 256; i++) {
  418.     if (isUPPER(i)) fold[i] = toLOWER(i);
  419.     else if (isLOWER(i)) fold[i] = toUPPER(i);
  420.     else fold[i] = i;
  421.     }
  422. #endif
  423.     return ok;
  424. }
  425.  
  426. void
  427. fbm_compile(sv, iflag)
  428. SV *sv;
  429. I32 iflag;
  430. {
  431.     register unsigned char *s;
  432.     register unsigned char *table;
  433.     register U32 i;
  434.     register U32 len = SvCUR(sv);
  435.     I32 rarest = 0;
  436.     U32 frequency = 256;
  437.  
  438.     if (len > 255)
  439.     return;            /* can't have offsets that big */
  440.     Sv_Grow(sv,len+258);
  441.     table = (unsigned char*)(SvPVX(sv) + len + 1);
  442.     s = table - 2;
  443.     for (i = 0; i < 256; i++) {
  444.     table[i] = len;
  445.     }
  446.     i = 0;
  447.     while (s >= (unsigned char*)(SvPVX(sv)))
  448.     {
  449.     if (table[*s] == len) {
  450. #ifndef pdp11
  451.         if (iflag)
  452.         table[*s] = table[fold[*s]] = i;
  453. #else
  454.         if (iflag) {
  455.         I32 j;
  456.         j = fold[*s];
  457.         table[j] = i;
  458.         table[*s] = i;
  459.         }
  460. #endif /* pdp11 */
  461.         else
  462.         table[*s] = i;
  463.     }
  464.     s--,i++;
  465.     }
  466.     sv_upgrade(sv, SVt_PVBM);
  467.     sv_magic(sv, Nullsv, 'B', Nullch, 0);            /* deep magic */
  468.     SvVALID_on(sv);
  469.  
  470.     s = (unsigned char*)(SvPVX(sv));        /* deeper magic */
  471.     if (iflag) {
  472.     register U32 tmp, foldtmp;
  473.     SvCASEFOLD_on(sv);
  474.     for (i = 0; i < len; i++) {
  475.         tmp=freq[s[i]];
  476.         foldtmp=freq[fold[s[i]]];
  477.         if (tmp < frequency && foldtmp < frequency) {
  478.         rarest = i;
  479.         /* choose most frequent among the two */
  480.         frequency = (tmp > foldtmp) ? tmp : foldtmp;
  481.         }
  482.     }
  483.     }
  484.     else {
  485.     for (i = 0; i < len; i++) {
  486.         if (freq[s[i]] < frequency) {
  487.         rarest = i;
  488.         frequency = freq[s[i]];
  489.         }
  490.     }
  491.     }
  492.     BmRARE(sv) = s[rarest];
  493.     BmPREVIOUS(sv) = rarest;
  494.     DEBUG_r(fprintf(Perl_debug_log,"rarest char %c at %d\n",BmRARE(sv),BmPREVIOUS(sv)));
  495. }
  496.  
  497. char *
  498. fbm_instr(big, bigend, littlestr)
  499. unsigned char *big;
  500. register unsigned char *bigend;
  501. SV *littlestr;
  502. {
  503.     register unsigned char *s;
  504.     register I32 tmp;
  505.     register I32 littlelen;
  506.     register unsigned char *little;
  507.     register unsigned char *table;
  508.     register unsigned char *olds;
  509.     register unsigned char *oldlittle;
  510.  
  511.     if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
  512.     STRLEN len;
  513.     char *l = SvPV(littlestr,len);
  514.     if (!len)
  515.         return (char*)big;
  516.     return ninstr((char*)big,(char*)bigend, l, l + len);
  517.     }
  518.  
  519.     littlelen = SvCUR(littlestr);
  520.     if (SvTAIL(littlestr) && !multiline) {    /* tail anchored? */
  521.     if (littlelen > bigend - big)
  522.         return Nullch;
  523.     little = (unsigned char*)SvPVX(littlestr);
  524.     if (SvCASEFOLD(littlestr)) {    /* oops, fake it */
  525.         big = bigend - littlelen;        /* just start near end */
  526.         if (bigend[-1] == '\n' && little[littlelen-1] != '\n')
  527.         big--;
  528.     }
  529.     else {
  530.         s = bigend - littlelen;
  531.         if (*s == *little && bcmp((char*)s,(char*)little,littlelen)==0)
  532.         return (char*)s;        /* how sweet it is */
  533.         else if (bigend[-1] == '\n' && little[littlelen-1] != '\n'
  534.           && s > big) {
  535.             s--;
  536.         if (*s == *little && bcmp((char*)s,(char*)little,littlelen)==0)
  537.             return (char*)s;
  538.         }
  539.         return Nullch;
  540.     }
  541.     }
  542.     table = (unsigned char*)(SvPVX(littlestr) + littlelen + 1);
  543.     if (--littlelen >= bigend - big)
  544.     return Nullch;
  545.     s = big + littlelen;
  546.     oldlittle = little = table - 2;
  547.     if (SvCASEFOLD(littlestr)) {    /* case insensitive? */
  548.     if (s < bigend) {
  549.       top1:
  550.         /*SUPPRESS 560*/
  551.         if (tmp = table[*s]) {
  552. #ifdef POINTERRIGOR
  553.         if (bigend - s > tmp) {
  554.             s += tmp;
  555.             goto top1;
  556.         }
  557. #else
  558.         if ((s += tmp) < bigend)
  559.             goto top1;
  560. #endif
  561.         return Nullch;
  562.         }
  563.         else {
  564.         tmp = littlelen;    /* less expensive than calling strncmp() */
  565.         olds = s;
  566.         while (tmp--) {
  567.             if (*--s == *--little || fold[*s] == *little)
  568.             continue;
  569.             s = olds + 1;    /* here we pay the price for failure */
  570.             little = oldlittle;
  571.             if (s < bigend)    /* fake up continue to outer loop */
  572.             goto top1;
  573.             return Nullch;
  574.         }
  575.         return (char *)s;
  576.         }
  577.     }
  578.     }
  579.     else {
  580.     if (s < bigend) {
  581.       top2:
  582.         /*SUPPRESS 560*/
  583.         if (tmp = table[*s]) {
  584. #ifdef POINTERRIGOR
  585.         if (bigend - s > tmp) {
  586.             s += tmp;
  587.             goto top2;
  588.         }
  589. #else
  590.         if ((s += tmp) < bigend)
  591.             goto top2;
  592. #endif
  593.         return Nullch;
  594.         }
  595.         else {
  596.         tmp = littlelen;    /* less expensive than calling strncmp() */
  597.         olds = s;
  598.         while (tmp--) {
  599.             if (*--s == *--little)
  600.             continue;
  601.             s = olds + 1;    /* here we pay the price for failure */
  602.             little = oldlittle;
  603.             if (s < bigend)    /* fake up continue to outer loop */
  604.             goto top2;
  605.             return Nullch;
  606.         }
  607.         return (char *)s;
  608.         }
  609.     }
  610.     }
  611.     return Nullch;
  612. }
  613.  
  614. char *
  615. screaminstr(bigstr, littlestr)
  616. SV *bigstr;
  617. SV *littlestr;
  618. {
  619.     register unsigned char *s, *x;
  620.     register unsigned char *big;
  621.     register I32 pos;
  622.     register I32 previous;
  623.     register I32 first;
  624.     register unsigned char *little;
  625.     register unsigned char *bigend;
  626.     register unsigned char *littleend;
  627.  
  628.     if ((pos = screamfirst[BmRARE(littlestr)]) < 0) 
  629.     return Nullch;
  630.     little = (unsigned char *)(SvPVX(littlestr));
  631.     littleend = little + SvCUR(littlestr);
  632.     first = *little++;
  633.     previous = BmPREVIOUS(littlestr);
  634.     big = (unsigned char *)(SvPVX(bigstr));
  635.     bigend = big + SvCUR(bigstr);
  636.     while (pos < previous) {
  637.     if (!(pos += screamnext[pos]))
  638.         return Nullch;
  639.     }
  640. #ifdef POINTERRIGOR
  641.     if (SvCASEFOLD(littlestr)) {    /* case insignificant? */
  642.     do {
  643.         if (big[pos-previous] != first && big[pos-previous] != fold[first])
  644.         continue;
  645.         for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
  646.         if (x >= bigend)
  647.             return Nullch;
  648.         if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
  649.             s--;
  650.             break;
  651.         }
  652.         }
  653.         if (s == littleend)
  654.         return (char *)(big+pos-previous);
  655.     } while (
  656.         pos += screamnext[pos]    /* does this goof up anywhere? */
  657.         );
  658.     }
  659.     else {
  660.     do {
  661.         if (big[pos-previous] != first)
  662.         continue;
  663.         for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
  664.         if (x >= bigend)
  665.             return Nullch;
  666.         if (*s++ != *x++) {
  667.             s--;
  668.             break;
  669.         }
  670.         }
  671.         if (s == littleend)
  672.         return (char *)(big+pos-previous);
  673.     } while ( pos += screamnext[pos] );
  674.     }
  675. #else /* !POINTERRIGOR */
  676.     big -= previous;
  677.     if (SvCASEFOLD(littlestr)) {    /* case insignificant? */
  678.     do {
  679.         if (big[pos] != first && big[pos] != fold[first])
  680.         continue;
  681.         for (x=big+pos+1,s=little; s < littleend; /**/ ) {
  682.         if (x >= bigend)
  683.             return Nullch;
  684.         if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
  685.             s--;
  686.             break;
  687.         }
  688.         }
  689.         if (s == littleend)
  690.         return (char *)(big+pos);
  691.     } while (
  692.         pos += screamnext[pos]    /* does this goof up anywhere? */
  693.         );
  694.     }
  695.     else {
  696.     do {
  697.         if (big[pos] != first)
  698.         continue;
  699.         for (x=big+pos+1,s=little; s < littleend; /**/ ) {
  700.         if (x >= bigend)
  701.             return Nullch;
  702.         if (*s++ != *x++) {
  703.             s--;
  704.             break;
  705.         }
  706.         }
  707.         if (s == littleend)
  708.         return (char *)(big+pos);
  709.     } while (
  710.         pos += screamnext[pos]
  711.         );
  712.     }
  713. #endif /* POINTERRIGOR */
  714.     return Nullch;
  715. }
  716.  
  717. I32
  718. ibcmp(a,b,len)
  719. register U8 *a;
  720. register U8 *b;
  721. register I32 len;
  722. {
  723.     while (len--) {
  724.     if (*a == *b) {
  725.         a++,b++;
  726.         continue;
  727.     }
  728.     if (fold[*a++] == *b++)
  729.         continue;
  730.     return 1;
  731.     }
  732.     return 0;
  733. }
  734.  
  735. /* copy a string to a safe spot */
  736.  
  737. char *
  738. savepv(sv)
  739. char *sv;
  740. {
  741.     register char *newaddr;
  742.  
  743.     New(902,newaddr,strlen(sv)+1,char);
  744.     (void)strcpy(newaddr,sv);
  745.     return newaddr;
  746. }
  747.  
  748. /* same thing but with a known length */
  749.  
  750. char *
  751. savepvn(sv, len)
  752. char *sv;
  753. register I32 len;
  754. {
  755.     register char *newaddr;
  756.  
  757.     New(903,newaddr,len+1,char);
  758.     Copy(sv,newaddr,len,char);        /* might not be null terminated */
  759.     newaddr[len] = '\0';        /* is now */
  760.     return newaddr;
  761. }
  762.  
  763. #if !defined(I_STDARG) && !defined(I_VARARGS)
  764.  
  765. /*
  766.  * Fallback on the old hackers way of doing varargs
  767.  */
  768.  
  769. /*VARARGS1*/
  770. char *
  771. mess(pat,a1,a2,a3,a4)
  772. char *pat;
  773. long a1, a2, a3, a4;
  774. {
  775.     char *s;
  776.     char *s_start;
  777.     I32 usermess = strEQ(pat,"%s");
  778.     SV *tmpstr;
  779.  
  780.     s = s_start = buf;
  781.     if (usermess) {
  782.     tmpstr = sv_newmortal();
  783.     sv_setpv(tmpstr, (char*)a1);
  784.     *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
  785.     }
  786.     else {
  787.     (void)sprintf(s,pat,a1,a2,a3,a4);
  788.     s += strlen(s);
  789.     }
  790.  
  791.     if (s[-1] != '\n') {
  792.     if (dirty)
  793.         strcpy(s, " during global destruction.\n");
  794.     else {
  795.         if (curcop->cop_line) {
  796.         (void)sprintf(s," at %s line %ld",
  797.           SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
  798.         s += strlen(s);
  799.         }
  800.         if (GvIO(last_in_gv) &&
  801.         IoLINES(GvIOp(last_in_gv)) ) {
  802.         (void)sprintf(s,", <%s> %s %ld",
  803.           last_in_gv == argvgv ? "" : GvENAME(last_in_gv),
  804.           strEQ(rs,"\n") ? "line" : "chunk", 
  805.           (long)IoLINES(GvIOp(last_in_gv)));
  806.         s += strlen(s);
  807.         }
  808.         (void)strcpy(s,".\n");
  809.         s += 2;
  810.     }
  811.     if (usermess)
  812.         sv_catpv(tmpstr,buf+1);
  813.     }
  814.  
  815.     if (s - s_start >= sizeof(buf)) {    /* Ooops! */
  816.     if (usermess)
  817.         fputs(SvPVX(tmpstr), stderr);
  818.     else
  819.         fputs(buf, stderr);
  820.     fputs("panic: message overflow - memory corrupted!\n",stderr);
  821.     my_exit(1);
  822.     }
  823.     if (usermess)
  824.     return SvPVX(tmpstr);
  825.     else
  826.     return buf;
  827. }
  828.  
  829. /*VARARGS1*/
  830. void croak(pat,a1,a2,a3,a4)
  831. char *pat;
  832. long a1, a2, a3, a4;
  833. {
  834.     char *tmps;
  835.     char *message;
  836.     HV *stash;
  837.     GV *gv;
  838.     CV *cv;
  839.  
  840.     message = mess(pat,a1,a2,a3,a4);
  841.     if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  842.     dSP;
  843.  
  844.     PUSHMARK(sp);
  845.     EXTEND(sp, 1);
  846.     PUSHs(sv_2mortal(newSVpv(message,0)));
  847.     PUTBACK;
  848.     perl_call_sv((SV*)cv, G_DISCARD);
  849.     }
  850.     if (in_eval) {
  851.     restartop = die_where(message);
  852.     Siglongjmp(top_env, 3);
  853.     }
  854.     fputs(message,stderr);
  855.     (void)Fflush(stderr);
  856.     if (e_tmpname) {
  857.     if (e_fp) {
  858.         fclose(e_fp);
  859.         e_fp = Nullfp;
  860.     }
  861.     (void)UNLINK(e_tmpname);
  862.     Safefree(e_tmpname);
  863.     e_tmpname = Nullch;
  864.     }
  865.     statusvalue = SHIFTSTATUS(statusvalue);
  866. #ifdef VMS
  867.     my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
  868. #else
  869.     my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
  870. #endif
  871. }
  872.  
  873. /*VARARGS1*/
  874. void warn(pat,a1,a2,a3,a4)
  875. char *pat;
  876. long a1, a2, a3, a4;
  877. {
  878.     char *message;
  879.     SV *sv;
  880.     HV *stash;
  881.     GV *gv;
  882.     CV *cv;
  883.  
  884.     message = mess(pat,a1,a2,a3,a4);
  885.     if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  886.     dSP;
  887.  
  888.     PUSHMARK(sp);
  889.     EXTEND(sp, 1);
  890.     PUSHs(sv_2mortal(newSVpv(message,0)));
  891.     PUTBACK;
  892.     perl_call_sv((SV*)cv, G_DISCARD);
  893.     }
  894.     else {
  895.     fputs(message,stderr);
  896. #ifdef LEAKTEST
  897.     DEBUG_L(xstat());
  898. #endif
  899.     (void)Fflush(stderr);
  900.     }
  901. }
  902.  
  903. #else /* !defined(I_STDARG) && !defined(I_VARARGS) */
  904.  
  905. #ifdef I_STDARG
  906. char *
  907. mess(char *pat, va_list *args)
  908. #else
  909. /*VARARGS0*/
  910. char *
  911. mess(pat, args)
  912.     char *pat;
  913.     va_list *args;
  914. #endif
  915. {
  916.     char *s;
  917.     char *s_start;
  918.     SV *tmpstr;
  919.     I32 usermess;
  920. #ifndef HAS_VPRINTF
  921. #ifdef USE_CHAR_VSPRINTF
  922.     char *vsprintf();
  923. #else
  924.     I32 vsprintf();
  925. #endif
  926. #endif
  927.  
  928.     s = s_start = buf;
  929.     usermess = strEQ(pat, "%s");
  930.     if (usermess) {
  931.     tmpstr = sv_newmortal();
  932. #ifdef macintosh
  933.     s_start = va_arg(*args, char *);
  934.     sv_setpv(tmpstr, strncmp(s_start, "# ", 2) ? "# " : "");
  935.     sv_catpv(tmpstr, s_start);
  936.     s_start = s;
  937. #else
  938.     sv_setpv(tmpstr, va_arg(*args, char *));
  939. #endif
  940.     *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
  941.     }
  942.     else {
  943. #ifdef macintosh
  944.     strcpy(s, "# ");
  945.     (void) vsprintf(s+2,pat,*args);
  946. #else
  947.     (void) vsprintf(s,pat,*args);
  948. #endif
  949.     s += strlen(s);
  950.     }
  951.     va_end(*args);
  952.  
  953.     if (s[-1] != '\n') {
  954.     if (dirty)
  955.         strcpy(s, " during global destruction.\n");
  956.     else {
  957. #ifdef macintosh
  958.         if (curcop->cop_line) {
  959.         (void)strcpy(s, ".\n");
  960.         s = MPWPosIndication(
  961.                 s+2,
  962.                 SvPVX(GvSV(curcop->cop_filegv)),
  963.                 curcop->cop_line);
  964.         }
  965.         if (GvIO(last_in_gv) && IoLINES(GvIOp(last_in_gv))) {
  966.         bool line_mode = (RsSIMPLE(rs) &&
  967.                   SvLEN(rs) == 1 && *SvPVX(rs) == '\n');
  968.         (void)sprintf(s," # <%s> %s %ld",
  969.           last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
  970.           line_mode ? "line" : "chunk", 
  971.           (long)IoLINES(GvIOp(last_in_gv)));
  972.         } else if (curcop->cop_line)
  973.             (void)strcpy(s,"\n");
  974.         else
  975.             (void)strcpy(s,".\n");
  976.         s += strlen(s);
  977. #else
  978.         if (curcop->cop_line) {
  979.         (void)sprintf(s," at %s line %ld",
  980.           SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
  981.         s += strlen(s);
  982.         }
  983.         if (GvIO(last_in_gv) && IoLINES(GvIOp(last_in_gv))) {
  984.         bool line_mode = (RsSIMPLE(rs) &&
  985.                   SvLEN(rs) == 1 && *SvPVX(rs) == '\n');
  986.         (void)sprintf(s,", <%s> %s %ld",
  987.           last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
  988.           line_mode ? "line" : "chunk", 
  989.           (long)IoLINES(GvIOp(last_in_gv)));
  990.         s += strlen(s);
  991.         }
  992.         (void)strcpy(s,".\n");
  993.         s += 2;
  994. #endif
  995.     }
  996.     if (usermess)
  997.         sv_catpv(tmpstr,buf+1);
  998.     }
  999.  
  1000.     if (s - s_start >= sizeof(buf)) {    /* Ooops! */
  1001.     if (usermess)
  1002.         fputs(SvPVX(tmpstr), stderr);
  1003.     else
  1004.         fputs(buf, stderr);
  1005. #ifdef macintosh
  1006.     MPWPosCommit();
  1007. #endif
  1008.     fputs("panic: message overflow - memory corrupted!\n",stderr);
  1009.     my_exit(1);
  1010.     }
  1011.     if (usermess)
  1012.     return SvPVX(tmpstr);
  1013.     else
  1014.     return buf;
  1015. }
  1016.  
  1017. #ifdef I_STDARG
  1018. void
  1019. croak(char* pat, ...)
  1020. #else
  1021. /*VARARGS0*/
  1022. void
  1023. croak(pat, va_alist)
  1024.     char *pat;
  1025.     va_dcl
  1026. #endif
  1027. {
  1028.     va_list args;
  1029.     char *message;
  1030.     HV *stash;
  1031.     GV *gv;
  1032.     CV *cv;
  1033.  
  1034. #ifdef I_STDARG
  1035.     va_start(args, pat);
  1036. #else
  1037.     va_start(args);
  1038. #endif
  1039.     message = mess(pat, &args);
  1040.     va_end(args);
  1041.     if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  1042.     dSP;
  1043.  
  1044.     PUSHMARK(sp);
  1045.     EXTEND(sp, 1);
  1046.     PUSHs(sv_2mortal(newSVpv(message,0)));
  1047.     PUTBACK;
  1048.     perl_call_sv((SV*)cv, G_DISCARD);
  1049.     }
  1050.     if (in_eval) {
  1051.     restartop = die_where(message);
  1052.     Siglongjmp(top_env, 3);
  1053.     }
  1054.     fputs(message,stderr);
  1055.     (void)Fflush(stderr);
  1056. #ifdef macintosh
  1057.     MPWPosCommit();
  1058. #endif
  1059.     if (e_tmpname) {
  1060.     if (e_fp) {
  1061.         fclose(e_fp);
  1062.         e_fp = Nullfp;
  1063.     }
  1064.     (void)UNLINK(e_tmpname);
  1065.     Safefree(e_tmpname);
  1066.     e_tmpname = Nullch;
  1067.     }
  1068.     statusvalue = SHIFTSTATUS(statusvalue);
  1069. #ifdef VMS
  1070.     my_exit((U32)(vaxc$errno?vaxc$errno:(statusvalue?statusvalue:44)));
  1071. #else
  1072.     my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
  1073. #endif
  1074. }
  1075.  
  1076. void
  1077. #ifdef I_STDARG
  1078. warn(char* pat,...)
  1079. #else
  1080. /*VARARGS0*/
  1081. warn(pat,va_alist)
  1082.     char *pat;
  1083.     va_dcl
  1084. #endif
  1085. {
  1086.     va_list args;
  1087.     char *message;
  1088.     HV *stash;
  1089.     GV *gv;
  1090.     CV *cv;
  1091.  
  1092. #ifdef I_STDARG
  1093.     va_start(args, pat);
  1094. #else
  1095.     va_start(args);
  1096. #endif
  1097.     message = mess(pat, &args);
  1098.     va_end(args);
  1099.  
  1100.     if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  1101.     dSP;
  1102.  
  1103.     PUSHMARK(sp);
  1104.     EXTEND(sp, 1);
  1105.     PUSHs(sv_2mortal(newSVpv(message,0)));
  1106.     PUTBACK;
  1107.     perl_call_sv((SV*)cv, G_DISCARD);
  1108.     }
  1109.     else {
  1110.     fputs(message,stderr);
  1111. #ifdef LEAKTEST
  1112.     DEBUG_L(xstat());
  1113. #endif
  1114.     (void)Fflush(stderr);
  1115. #ifdef macintosh
  1116.     MPWPosCommit();
  1117. #endif
  1118.     }
  1119. }
  1120. #endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
  1121.  
  1122. #ifndef VMS  /* VMS' my_setenv() is in VMS.c */
  1123. void
  1124. my_setenv(nam,val)
  1125. char *nam, *val;
  1126. {
  1127.     register I32 i=setenv_getix(nam);        /* where does it go? */
  1128.  
  1129.     if (environ == origenviron) {    /* need we copy environment? */
  1130.     I32 j;
  1131.     I32 max;
  1132.     char **tmpenv;
  1133.  
  1134.     /*SUPPRESS 530*/
  1135.     for (max = i; environ[max]; max++) ;
  1136.     New(901,tmpenv, max+2, char*);
  1137.     for (j=0; j<max; j++)        /* copy environment */
  1138.         tmpenv[j] = savepv(environ[j]);
  1139.     tmpenv[max] = Nullch;
  1140.     environ = tmpenv;        /* tell exec where it is now */
  1141.     }
  1142.     if (!val) {
  1143.     while (environ[i]) {
  1144.         environ[i] = environ[i+1];
  1145.         i++;
  1146.     }
  1147.     return;
  1148.     }
  1149.     if (!environ[i]) {            /* does not exist yet */
  1150.     Renew(environ, i+2, char*);    /* just expand it a bit */
  1151.     environ[i+1] = Nullch;    /* make sure it's null terminated */
  1152.     }
  1153.     else
  1154.     Safefree(environ[i]);
  1155.     New(904, environ[i], strlen(nam) + strlen(val) + 2, char);
  1156. #ifndef MSDOS
  1157.     (void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
  1158. #else
  1159.     /* MS-DOS requires environment variable names to be in uppercase */
  1160.     /* [Tom Dinger, 27 August 1990: Well, it doesn't _require_ it, but
  1161.      * some utilities and applications may break because they only look
  1162.      * for upper case strings. (Fixed strupr() bug here.)]
  1163.      */
  1164.     strcpy(environ[i],nam); strupr(environ[i]);
  1165.     (void)sprintf(environ[i] + strlen(nam),"=%s",val);
  1166. #endif /* MSDOS */
  1167. }
  1168.  
  1169. I32
  1170. setenv_getix(nam)
  1171. char *nam;
  1172. {
  1173.     register I32 i, len = strlen(nam);
  1174.  
  1175.     for (i = 0; environ[i]; i++) {
  1176.     if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
  1177.         break;            /* strnEQ must come first to avoid */
  1178.     }                    /* potential SEGV's */
  1179.     return i;
  1180. }
  1181. #endif /* !VMS */
  1182.  
  1183. #ifdef UNLINK_ALL_VERSIONS
  1184. I32
  1185. unlnk(f)    /* unlink all versions of a file */
  1186. char *f;
  1187. {
  1188.     I32 i;
  1189.  
  1190.     for (i = 0; unlink(f) >= 0; i++) ;
  1191.     return i ? 0 : -1;
  1192. }
  1193. #endif
  1194.  
  1195. #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
  1196. char *
  1197. my_bcopy(from,to,len)
  1198. register char *from;
  1199. register char *to;
  1200. register I32 len;
  1201. {
  1202.     char *retval = to;
  1203.  
  1204.     if (from - to >= 0) {
  1205.     while (len--)
  1206.         *to++ = *from++;
  1207.     }
  1208.     else {
  1209.     to += len;
  1210.     from += len;
  1211.     while (len--)
  1212.         *(--to) = *(--from);
  1213.     }
  1214.     return retval;
  1215. }
  1216. #endif
  1217.  
  1218. #if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
  1219. char *
  1220. my_bzero(loc,len)
  1221. register char *loc;
  1222. register I32 len;
  1223. {
  1224.     char *retval = loc;
  1225.  
  1226.     while (len--)
  1227.     *loc++ = 0;
  1228.     return retval;
  1229. }
  1230. #endif
  1231.  
  1232. #ifndef HAS_MEMCMP
  1233. I32
  1234. my_memcmp(s1,s2,len)
  1235. register unsigned char *s1;
  1236. register unsigned char *s2;
  1237. register I32 len;
  1238. {
  1239.     register I32 tmp;
  1240.  
  1241.     while (len--) {
  1242.     if (tmp = *s1++ - *s2++)
  1243.         return tmp;
  1244.     }
  1245.     return 0;
  1246. }
  1247. #endif /* HAS_MEMCMP */
  1248.  
  1249. #if defined(I_STDARG) || defined(I_VARARGS)
  1250. #ifndef HAS_VPRINTF
  1251.  
  1252. #ifdef USE_CHAR_VSPRINTF
  1253. char *
  1254. #else
  1255. int
  1256. #endif
  1257. vsprintf(dest, pat, args)
  1258. char *dest, *pat, *args;
  1259. {
  1260.     FILE fakebuf;
  1261.  
  1262.     fakebuf._ptr = dest;
  1263.     fakebuf._cnt = 32767;
  1264. #ifndef _IOSTRG
  1265. #define _IOSTRG 0
  1266. #endif
  1267.     fakebuf._flag = _IOWRT|_IOSTRG;
  1268.     _doprnt(pat, args, &fakebuf);    /* what a kludge */
  1269.     (void)putc('\0', &fakebuf);
  1270. #ifdef USE_CHAR_VSPRINTF
  1271.     return(dest);
  1272. #else
  1273.     return 0;        /* perl doesn't use return value */
  1274. #endif
  1275. }
  1276.  
  1277. int
  1278. vfprintf(fd, pat, args)
  1279. FILE *fd;
  1280. char *pat, *args;
  1281. {
  1282.     _doprnt(pat, args, fd);
  1283.     return 0;        /* wrong, but perl doesn't use the return value */
  1284. }
  1285. #endif /* HAS_VPRINTF */
  1286. #endif /* I_VARARGS || I_STDARGS */
  1287.  
  1288. #ifdef MYSWAP
  1289. #if BYTEORDER != 0x4321
  1290. short
  1291. #ifndef CAN_PROTOTYPE
  1292. my_swap(s)
  1293. short s;
  1294. #else
  1295. my_swap(short s)
  1296. #endif
  1297. {
  1298. #if (BYTEORDER & 1) == 0
  1299.     short result;
  1300.  
  1301.     result = ((s & 255) << 8) + ((s >> 8) & 255);
  1302.     return result;
  1303. #else
  1304.     return s;
  1305. #endif
  1306. }
  1307.  
  1308. long
  1309. #ifndef CAN_PROTOTYPE
  1310. my_htonl(l)
  1311. register long l;
  1312. #else
  1313. my_htonl(long l)
  1314. #endif
  1315. {
  1316.     union {
  1317.     long result;
  1318.     char c[sizeof(long)];
  1319.     } u;
  1320.  
  1321. #if BYTEORDER == 0x1234
  1322.     u.c[0] = (l >> 24) & 255;
  1323.     u.c[1] = (l >> 16) & 255;
  1324.     u.c[2] = (l >> 8) & 255;
  1325.     u.c[3] = l & 255;
  1326.     return u.result;
  1327. #else
  1328. #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
  1329.     croak("Unknown BYTEORDER\n");
  1330. #else
  1331.     register I32 o;
  1332.     register I32 s;
  1333.  
  1334.     for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
  1335.     u.c[o & 0xf] = (l >> s) & 255;
  1336.     }
  1337.     return u.result;
  1338. #endif
  1339. #endif
  1340. }
  1341.  
  1342. long
  1343. #ifndef CAN_PROTOTYPE
  1344. my_ntohl(l)
  1345. register long l;
  1346. #else
  1347. my_ntohl(long l)
  1348. #endif
  1349. {
  1350.     union {
  1351.     long l;
  1352.     char c[sizeof(long)];
  1353.     } u;
  1354.  
  1355. #if BYTEORDER == 0x1234
  1356.     u.c[0] = (l >> 24) & 255;
  1357.     u.c[1] = (l >> 16) & 255;
  1358.     u.c[2] = (l >> 8) & 255;
  1359.     u.c[3] = l & 255;
  1360.     return u.l;
  1361. #else
  1362. #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
  1363.     croak("Unknown BYTEORDER\n");
  1364. #else
  1365.     register I32 o;
  1366.     register I32 s;
  1367.  
  1368.     u.l = l;
  1369.     l = 0;
  1370.     for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
  1371.     l |= (u.c[o & 0xf] & 255) << s;
  1372.     }
  1373.     return l;
  1374. #endif
  1375. #endif
  1376. }
  1377.  
  1378. #endif /* BYTEORDER != 0x4321 */
  1379. #endif /* MYSWAP */
  1380.  
  1381. /*
  1382.  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
  1383.  * If these functions are defined,
  1384.  * the BYTEORDER is neither 0x1234 nor 0x4321.
  1385.  * However, this is not assumed.
  1386.  * -DWS
  1387.  */
  1388.  
  1389. #define HTOV(name,type)                        \
  1390.     type                            \
  1391.     name (n)                        \
  1392.     register type n;                    \
  1393.     {                            \
  1394.         union {                        \
  1395.         type value;                    \
  1396.         char c[sizeof(type)];                \
  1397.         } u;                        \
  1398.         register I32 i;                    \
  1399.         register I32 s;                    \
  1400.         for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {    \
  1401.         u.c[i] = (n >> s) & 0xFF;            \
  1402.         }                            \
  1403.         return u.value;                    \
  1404.     }
  1405.  
  1406. #define VTOH(name,type)                        \
  1407.     type                            \
  1408.     name (n)                        \
  1409.     register type n;                    \
  1410.     {                            \
  1411.         union {                        \
  1412.         type value;                    \
  1413.         char c[sizeof(type)];                \
  1414.         } u;                        \
  1415.         register I32 i;                    \
  1416.         register I32 s;                    \
  1417.         u.value = n;                    \
  1418.         n = 0;                        \
  1419.         for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {    \
  1420.         n += (u.c[i] & 0xFF) << s;            \
  1421.         }                            \
  1422.         return n;                        \
  1423.     }
  1424.  
  1425. #if defined(HAS_HTOVS) && !defined(htovs)
  1426. HTOV(htovs,short)
  1427. #endif
  1428. #if defined(HAS_HTOVL) && !defined(htovl)
  1429. HTOV(htovl,long)
  1430. #endif
  1431. #if defined(HAS_VTOHS) && !defined(vtohs)
  1432. VTOH(vtohs,short)
  1433. #endif
  1434. #if defined(HAS_VTOHL) && !defined(vtohl)
  1435. VTOH(vtohl,long)
  1436. #endif
  1437.  
  1438. #if  !defined(DOSISH) && !defined(macintosh) && !defined(VMS)  /* VMS' my_popen() is in
  1439.                        VMS.c, same with OS/2. */
  1440. FILE *
  1441. my_popen(cmd,mode)
  1442. char    *cmd;
  1443. char    *mode;
  1444. {
  1445.     int p[2];
  1446.     register I32 this, that;
  1447.     register I32 pid;
  1448.     SV *sv;
  1449.     I32 doexec = strNE(cmd,"-");
  1450.  
  1451.     if (pipe(p) < 0)
  1452.     return Nullfp;
  1453.     this = (*mode == 'w');
  1454.     that = !this;
  1455.     if (tainting) {
  1456.     if (doexec) {
  1457.         taint_env();
  1458.         taint_proper("Insecure %s%s", "EXEC");
  1459.     }
  1460.     }
  1461.     while ((pid = (doexec?vfork():fork())) < 0) {
  1462.     if (errno != EAGAIN) {
  1463.         close(p[this]);
  1464.         if (!doexec)
  1465.         croak("Can't fork");
  1466.         return Nullfp;
  1467.     }
  1468.     sleep(5);
  1469.     }
  1470.     if (pid == 0) {
  1471.     GV* tmpgv;
  1472.  
  1473. #define THIS that
  1474. #define THAT this
  1475.     close(p[THAT]);
  1476.     if (p[THIS] != (*mode == 'r')) {
  1477.         dup2(p[THIS], *mode == 'r');
  1478.         close(p[THIS]);
  1479.     }
  1480.     if (doexec) {
  1481. #if !defined(HAS_FCNTL) || !defined(F_SETFD)
  1482.         int fd;
  1483.  
  1484. #ifndef NOFILE
  1485. #define NOFILE 20
  1486. #endif
  1487.         for (fd = maxsysfd + 1; fd < NOFILE; fd++)
  1488.         close(fd);
  1489. #endif
  1490.         do_exec(cmd);    /* may or may not use the shell */
  1491.         _exit(1);
  1492.     }
  1493.     /*SUPPRESS 560*/
  1494.     if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
  1495.         sv_setiv(GvSV(tmpgv),(I32)getpid());
  1496.     forkprocess = 0;
  1497.     hv_clear(pidstatus);    /* we have no children */
  1498.     return Nullfp;
  1499. #undef THIS
  1500. #undef THAT
  1501.     }
  1502.     do_execfree();    /* free any memory malloced by child on vfork */
  1503.     close(p[that]);
  1504.     if (p[that] < p[this]) {
  1505.     dup2(p[this], p[that]);
  1506.     close(p[this]);
  1507.     p[this] = p[that];
  1508.     }
  1509.     sv = *av_fetch(fdpid,p[this],TRUE);
  1510.     (void)SvUPGRADE(sv,SVt_IV);
  1511.     SvIVX(sv) = pid;
  1512.     forkprocess = pid;
  1513.     return fdopen(p[this], mode);
  1514. }
  1515. #else
  1516. #if defined(atarist)
  1517. FILE *popen();
  1518. FILE *
  1519. my_popen(cmd,mode)
  1520. char    *cmd;
  1521. char    *mode;
  1522. {
  1523.     return popen(cmd, mode);
  1524. }
  1525. #endif
  1526.  
  1527. #endif /* !DOSISH */
  1528.  
  1529. #ifdef DUMP_FDS
  1530. dump_fds(s)
  1531. char *s;
  1532. {
  1533.     int fd;
  1534.     struct stat tmpstatbuf;
  1535.  
  1536.     fprintf(stderr,"%s", s);
  1537.     for (fd = 0; fd < 32; fd++) {
  1538.     if (Fstat(fd,&tmpstatbuf) >= 0)
  1539.         fprintf(stderr," %d",fd);
  1540.     }
  1541.     fprintf(stderr,"\n");
  1542. }
  1543. #endif
  1544.  
  1545. #ifndef HAS_DUP2
  1546. int
  1547. dup2(oldfd,newfd)
  1548. int oldfd;
  1549. int newfd;
  1550. {
  1551. #if defined(HAS_FCNTL) && defined(F_DUPFD)
  1552.     if (oldfd == newfd)
  1553.     return oldfd;
  1554.     close(newfd);
  1555.     return fcntl(oldfd, F_DUPFD, newfd);
  1556. #else
  1557.     int fdtmp[256];
  1558.     I32 fdx = 0;
  1559.     int fd;
  1560.  
  1561.     if (oldfd == newfd)
  1562.     return oldfd;
  1563.     close(newfd);
  1564.     while ((fd = dup(oldfd)) != newfd && fd >= 0) /* good enough for low fd's */
  1565.     fdtmp[fdx++] = fd;
  1566.     while (fdx > 0)
  1567.     close(fdtmp[--fdx]);
  1568.     return fd;
  1569. #endif
  1570. }
  1571. #endif
  1572.  
  1573. #if  !defined(DOSISH) && !defined(macintosh) && !defined(VMS)  /* VMS' my_popen() is in VMS.c */
  1574. I32
  1575. my_pclose(ptr)
  1576. FILE *ptr;
  1577. {
  1578.     Signal_t (*hstat)(), (*istat)(), (*qstat)();
  1579.     int status;
  1580.     SV **svp;
  1581.     int pid;
  1582.  
  1583.     svp = av_fetch(fdpid,fileno(ptr),TRUE);
  1584.     pid = (int)SvIVX(*svp);
  1585.     SvREFCNT_dec(*svp);
  1586.     *svp = &sv_undef;
  1587.     fclose(ptr);
  1588. #ifdef UTS
  1589.     if(kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
  1590. #endif
  1591.     hstat = signal(SIGHUP, SIG_IGN);
  1592.     istat = signal(SIGINT, SIG_IGN);
  1593.     qstat = signal(SIGQUIT, SIG_IGN);
  1594.     do {
  1595.     pid = wait4pid(pid, &status, 0);
  1596.     } while (pid == -1 && errno == EINTR);
  1597.     signal(SIGHUP, hstat);
  1598.     signal(SIGINT, istat);
  1599.     signal(SIGQUIT, qstat);
  1600.     return(pid < 0 ? pid : status);
  1601. }
  1602. #endif /* !DOSISH */
  1603.  
  1604. #if  (!defined(DOSISH) || defined(OS2)) && !defined(macintosh)
  1605. I32
  1606. wait4pid(pid,statusp,flags)
  1607. int pid;
  1608. int *statusp;
  1609. int flags;
  1610. {
  1611.     SV *sv;
  1612.     SV** svp;
  1613.     char spid[16];
  1614.  
  1615.     if (!pid)
  1616.     return -1;
  1617.     if (pid > 0) {
  1618.     sprintf(spid, "%d", pid);
  1619.     svp = hv_fetch(pidstatus,spid,strlen(spid),FALSE);
  1620.     if (svp && *svp != &sv_undef) {
  1621.         *statusp = SvIVX(*svp);
  1622.         (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
  1623.         return pid;
  1624.     }
  1625.     }
  1626.     else {
  1627.     HE *entry;
  1628.  
  1629.     hv_iterinit(pidstatus);
  1630.     if (entry = hv_iternext(pidstatus)) {
  1631.         pid = atoi(hv_iterkey(entry,(I32*)statusp));
  1632.         sv = hv_iterval(pidstatus,entry);
  1633.         *statusp = SvIVX(sv);
  1634.         sprintf(spid, "%d", pid);
  1635.         (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
  1636.         return pid;
  1637.     }
  1638.     }
  1639. #ifdef HAS_WAITPID
  1640.     return waitpid(pid,statusp,flags);
  1641. #else
  1642. #ifdef HAS_WAIT4
  1643.     return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
  1644. #else
  1645.     {
  1646.     I32 result;
  1647.     if (flags)
  1648.         croak("Can't do waitpid with flags");
  1649.     else {
  1650.         while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
  1651.         pidgone(result,*statusp);
  1652.         if (result < 0)
  1653.         *statusp = -1;
  1654.     }
  1655.     return result;
  1656.     }
  1657. #endif
  1658. #endif
  1659. }
  1660. #endif /* !DOSISH */
  1661.  
  1662. void
  1663. /*SUPPRESS 590*/
  1664. pidgone(pid,status)
  1665. int pid;
  1666. int status;
  1667. {
  1668.     register SV *sv;
  1669.     char spid[16];
  1670.  
  1671.     sprintf(spid, "%d", pid);
  1672.     sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);
  1673.     (void)SvUPGRADE(sv,SVt_IV);
  1674.     SvIVX(sv) = status;
  1675.     return;
  1676. }
  1677.  
  1678. #if defined(atarist) || defined(OS2)
  1679. int pclose();
  1680. I32
  1681. my_pclose(ptr)
  1682. FILE *ptr;
  1683. {
  1684.     return pclose(ptr);
  1685. }
  1686. #endif
  1687.  
  1688. void
  1689. repeatcpy(to,from,len,count)
  1690. register char *to;
  1691. register char *from;
  1692. I32 len;
  1693. register I32 count;
  1694. {
  1695.     register I32 todo;
  1696.     register char *frombase = from;
  1697.  
  1698.     if (len == 1) {
  1699.     todo = *from;
  1700.     while (count-- > 0)
  1701.         *to++ = todo;
  1702.     return;
  1703.     }
  1704.     while (count-- > 0) {
  1705.     for (todo = len; todo > 0; todo--) {
  1706.         *to++ = *from++;
  1707.     }
  1708.     from = frombase;
  1709.     }
  1710. }
  1711.  
  1712. #ifndef CASTNEGFLOAT
  1713. U32
  1714. cast_ulong(f)
  1715. double f;
  1716. {
  1717.     long along;
  1718.  
  1719. #if CASTFLAGS & 2
  1720. #   define BIGDOUBLE 2147483648.0
  1721.     if (f >= BIGDOUBLE)
  1722.     return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
  1723. #endif
  1724.     if (f >= 0.0)
  1725.     return (unsigned long)f;
  1726.     along = (long)f;
  1727.     return (unsigned long)along;
  1728. }
  1729. # undef BIGDOUBLE
  1730. #endif
  1731.  
  1732. #ifndef CASTI32
  1733.  
  1734. /* Look for MAX and MIN integral values.  If we can't find them,
  1735.    we'll use 32-bit two's complement defaults.
  1736. */
  1737. #ifndef LONG_MAX
  1738. #  ifdef MAXLONG    /* Often used in <values.h> */
  1739. #    define LONG_MAX MAXLONG
  1740. #  else
  1741. #    define LONG_MAX        2147483647L
  1742. #  endif
  1743. #endif
  1744.  
  1745. #ifndef LONG_MIN
  1746. #    define LONG_MIN        (-LONG_MAX - 1)
  1747. #endif
  1748.  
  1749. #ifndef ULONG_MAX
  1750. #  ifdef MAXULONG 
  1751. #    define LONG_MAX MAXULONG
  1752. #  else
  1753. #    define ULONG_MAX       4294967295L
  1754. #  endif
  1755. #endif
  1756.  
  1757. /* Unfortunately, on some systems the cast_uv() function doesn't
  1758.    work with the system-supplied definition of ULONG_MAX.  The
  1759.    comparison  (f >= ULONG_MAX) always comes out true.  It must be a
  1760.    problem with the compiler constant folding.
  1761.  
  1762.    In any case, this workaround should be fine on any two's complement
  1763.    system.  If it's not, supply a '-DMY_ULONG_MAX=whatever' in your
  1764.    ccflags.
  1765.            --Andy Dougherty      <doughera@lafcol.lafayette.edu>
  1766. */
  1767. #ifndef MY_ULONG_MAX
  1768. #  define MY_ULONG_MAX ((UV)LONG_MAX * (UV)2 + (UV)1)
  1769. #endif
  1770.  
  1771. I32
  1772. cast_i32(f)
  1773. double f;
  1774. {
  1775.     if (f >= LONG_MAX)
  1776.     return (I32) LONG_MAX;
  1777.     if (f <= LONG_MIN)
  1778.     return (I32) LONG_MIN;
  1779.     return (I32) f;
  1780. }
  1781.  
  1782. IV
  1783. cast_iv(f)
  1784. double f;
  1785. {
  1786.     if (f >= LONG_MAX)
  1787.     return (IV) LONG_MAX;
  1788.     if (f <= LONG_MIN)
  1789.     return (IV) LONG_MIN;
  1790.     return (IV) f;
  1791. }
  1792.  
  1793. UV
  1794. cast_uv(f)
  1795. double f;
  1796. {
  1797.     if (f >= MY_ULONG_MAX)
  1798.     return (UV) MY_ULONG_MAX;
  1799.     return (UV) f;
  1800. }
  1801.  
  1802. #endif
  1803.  
  1804. #ifndef HAS_RENAME
  1805. I32
  1806. same_dirent(a,b)
  1807. char *a;
  1808. char *b;
  1809. {
  1810.     char *fa = strrchr(a,'/');
  1811.     char *fb = strrchr(b,'/');
  1812.     struct stat tmpstatbuf1;
  1813.     struct stat tmpstatbuf2;
  1814. #ifndef MAXPATHLEN
  1815. #define MAXPATHLEN 1024
  1816. #endif
  1817.     char tmpbuf[MAXPATHLEN+1];
  1818.  
  1819.     if (fa)
  1820.     fa++;
  1821.     else
  1822.     fa = a;
  1823.     if (fb)
  1824.     fb++;
  1825.     else
  1826.     fb = b;
  1827.     if (strNE(a,b))
  1828.     return FALSE;
  1829.     if (fa == a)
  1830.     strcpy(tmpbuf,".");
  1831.     else
  1832.     strncpy(tmpbuf, a, fa - a);
  1833.     if (Stat(tmpbuf, &tmpstatbuf1) < 0)
  1834.     return FALSE;
  1835.     if (fb == b)
  1836.     strcpy(tmpbuf,".");
  1837.     else
  1838.     strncpy(tmpbuf, b, fb - b);
  1839.     if (Stat(tmpbuf, &tmpstatbuf2) < 0)
  1840.     return FALSE;
  1841.     return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
  1842.        tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
  1843. }
  1844. #endif /* !HAS_RENAME */
  1845.  
  1846. unsigned long
  1847. scan_oct(start, len, retlen)
  1848. char *start;
  1849. I32 len;
  1850. I32 *retlen;
  1851. {
  1852.     register char *s = start;
  1853.     register unsigned long retval = 0;
  1854.  
  1855.     while (len && *s >= '0' && *s <= '7') {
  1856.     retval <<= 3;
  1857.     retval |= *s++ - '0';
  1858.     len--;
  1859.     }
  1860.     if (dowarn && len && (*s == '8' || *s == '9'))
  1861.     warn("Illegal octal digit ignored");
  1862.     *retlen = s - start;
  1863.     return retval;
  1864. }
  1865.  
  1866. unsigned long
  1867. scan_hex(start, len, retlen)
  1868. char *start;
  1869. I32 len;
  1870. I32 *retlen;
  1871. {
  1872.     register char *s = start;
  1873.     register unsigned long retval = 0;
  1874.     char *tmp;
  1875.  
  1876.     while (len-- && *s && (tmp = strchr(hexdigit, *s))) {
  1877.     retval <<= 4;
  1878.     retval |= (tmp - hexdigit) & 15;
  1879.     s++;
  1880.     }
  1881.     *retlen = s - start;
  1882.     return retval;
  1883. }
  1884.